home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Low Level Languages / FORTRAN.500 / DISK6 / FILL.FO$ / FILL.bin
Encoding:
Text File  |  1990-09-28  |  2.9 KB  |  93 lines
  1. CC  FILL.FOR - Illustrates color, filling, and linestyle functions
  2. CC             including:        floodfill            setfillmask
  3. CC                                getlinestyle        setlinestyle
  4. CC                                setcolor
  5. CC
  6. CC  The getfillmask function is not shown, but its use is similar 
  7. CC  to getlinestyle.
  8.  
  9.       INCLUDE  'FGRAPH.FI'
  10.       INCLUDE  'FGRAPH.FD'
  11.  
  12.       INTEGER*1            fill(8)
  13.       INTEGER*2            status, xinc, yinc, i,
  14.      +                     irand, xwid, ywid, rseed
  15.       INTEGER*4            ncolor
  16.       REAL*4               rand
  17.       RECORD /xycoord/     xy
  18.       RECORD /videoconfig/ vc
  19.  
  20. C
  21. C     Find graphics mode.
  22. C
  23.       IF( setvideomode( $MAXRESMODE ) .EQ. 0 ) 
  24.      +   STOP 'Error:  cannot set graphics mode'
  25.       CALL getvideoconfig( vc )
  26.  
  27. C
  28. C     Size variables to mode.
  29. C
  30.       xinc = vc.numxpixels / 8.0
  31.       yinc = vc.numypixels / 8.0
  32.       xwid = (xinc / 2.0) - 4.0
  33.       ywid = (yinc / 2.0) - 4.0
  34.  
  35. C
  36. C     Seed random-number generator.
  37. C
  38.       CALL GETTIM( status, status, status, rseed)
  39.       CALL SEED( rseed )
  40.  
  41. C
  42. C     Draw ellipses and lines with different patterns.
  43. C
  44.       DO x = xinc, (vc.numxpixels - xinc), xinc
  45.          DO y = yinc, (vc.numypixels - yinc), yinc
  46. C
  47. C           Randomize fill and color.  Array FILL holds
  48. C           random numbers between 0 and 255.
  49. C
  50.             DO i = 1, 8
  51.                CALL RANDOM( rand )
  52.                fill(i) = INT1( rand * 256.0 )
  53.             END DO
  54.  
  55.             CALL setfillmask( fill )
  56.             irand  = rand * 256.0
  57.             ncolor = MOD( irand, vc.numcolors ) + 1
  58.             status  = setcolor( ncolor )
  59. C
  60. C           Draw ellipse and fill with random color.
  61. C
  62.             status  = ellipse( $GBORDER, x - xwid, y - ywid,
  63.      +                         x + xwid, y + ywid )
  64.             CALL RANDOM( rand )
  65.             irand  = rand * 256.0
  66.             i      = ncolor
  67.             ncolor = MOD( irand, vc.numcolors ) + 1
  68.             status  = setcolor( ncolor )
  69.             status  = floodfill( x, y, i )
  70. C
  71. C           Draw vertical and horizontal lines. Vertical line style
  72. C           is anything other than horizontal style. Since lines 
  73. C           are overdrawn with several line styles, this has the
  74. C           effect of combining colors and styles.
  75. C
  76.             CALL RANDOM( rand )
  77.             irand = rand * 256.0
  78.             CALL setlinestyle( irand )
  79.             CALL moveto( 0, y + ywid + 4, xy )
  80.             status = lineto( vc.numxpixels - 1, y + ywid + 4 )
  81. C
  82. C           Get linestyle, invert bits, and reset linestyle.
  83. C
  84.             CALL setlinestyle( 255 - getlinestyle() )
  85.             CALL moveto( x + xwid + 4, 0, xy )
  86.             status = lineto( x + xwid + 4, vc.numypixels - 1 )
  87.          END DO
  88.       END DO
  89.  
  90.       READ (*,*)       ! Wait for ENTER to be pressed
  91.       status = setvideomode( $DEFAULTMODE )
  92.       END
  93.